home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The Original Shareware 1.1
/
The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso
/
32
/
five.zip
/
FIVE.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1987-03-14
|
45KB
|
1,242 lines
Program Five_thousand;
Const Max_players = 15;
Type Strategy = (Human,Comp_1,Comp_2,Comp_3);
Scores = record
Points: real;
Scratches: real;
Player_name: string[20];
Player_type: strategy;
On_board: boolean;
end;
Die = record
Value: integer;
Pulled: boolean;
Saved: boolean;
Marked: boolean;
end;
Dice = array[1..6] of Die;
Var Winnings: array[1..Max_players] of real;
Losses: array[1..Max_players] of real;
Score: array[0..Max_players] of Scores;
Last_player: integer;
Current_player: integer;
Next_player: integer;
Needed: real;
Last_players_score: real;
Games_played: integer;
Silent: boolean;
Number_of_players: integer;
Cup: Dice;
Humans_want_to_play: boolean;
Someone_over: boolean;
Problems: boolean;
Ch: char;
index: integer;
Procedure Randomize;
Var Reg_set: record
Ax: integer;
Bx: integer;
Cx: integer;
Dx: integer;
Bp: integer;
Si: integer;
Di: integer;
Ds: integer;
Es: integer;
Flags: integer;
end;
I: integer;
J: integer;
K: integer;
begin
Reg_set.Ax:= $2C00;
MSDos(Reg_set);
J:= Reg_set.Cx;
I:= Reg_set.Dx;
MemW[Dseg:$0129]:= I;
MemW[Dseg:$012B]:= J;
For i:= 1 to J mod 250 do
k:= random(i);
end;
Procedure Display_all_players;
Var Player: integer;
begin
window(36,2,78,24);
clrscr;
gotoxy(1,1);
writeln;
writeln(' PLAYERS AND THEIR SCORES');
writeln;
writeln;
writeln(' Name Score Scratches');
for Player:= 1 to Number_of_players do
begin
write(Player:2,': ',Score[Player].Player_name);
gotoxy(25,6 + Player);
writeln(Score[Player].Points:8:0,' ',
Score[Player].Scratches:5:0);
end;
if Number_of_players < 14
then
begin
writeln;
writeln;
end
else
if Number_of_players <=14
then
writeln;
if Number_of_players < 8
then
gotoxy(1,17);
writeln('The last player was: ',Score[Last_player].Player_name);
if Last_player <> 0
then
begin
write('Their score was: ');
textcolor(black);
textbackground(white);
write(Last_players_score:8:0);
textcolor(white);
textbackground(black);
end;
end;
Procedure Border;
Const Horiz = #205;
Vert = #186;
Top_left = #201;
Top_right = #187;
Bottom_left = #200;
Bottom_right = #188;
Top_center = #209;
Bottom_center = #207;
Center = #179;
Var x_pos: integer;
y_pos: integer;
begin
window(1,1,80,25);
clrscr;
For x_pos:= 1 to 79 do
write(Horiz);
gotoxy(1,25);
For x_pos:= 1 to 79 do
write(Horiz);
x_pos:= 1;
For y_pos:= 2 to 24 do
begin
gotoxy(x_pos,y_pos);
write(Vert);
end;
x_pos:= 79;
For y_pos:= 2 to 24 do
begin
gotoxy(x_pos,y_pos);
write(Vert);
end;
gotoxy(1,1);
write(Top_left);
gotoxy(79,1);
write(Top_right);
gotoxy(35,1);
write(Top_center);
gotoxy(1,25);
write(Bottom_left);
gotoxy(79,25);
write(Bottom_right);
gotoxy(35,25);
write(Bottom_center);
x_pos:= 35;
For y_pos:= 2 to 24 do
begin
gotoxy(x_pos,y_pos);
write(Center);
end;
end;
Procedure Initialize_all;
Var index: integer;
begin
Problems:= False;
Last_player:= 0;
Current_player:= 0;
Next_player:= 0;
Games_played:= 0;
Number_of_players:= 0;
Last_players_score:= 0.0;
Textcolor(white);
Textbackground(black);
For index:= 1 to Max_players do
begin
Winnings[index]:= 0.0;
Losses[index]:= 0.0;
with Score[index] do
begin
Points:= 0.0;
Scratches:= 0;
Player_name:='not yet assigne....d';
Player_type:= Human;
On_board:= False;
end;
end;
with Score[0] do
begin
Points:= 0.0;
Scratches:= 0;
Player_name:= 'New Game';
Player_type:= Human;
On_board:= False;
end;
Border;
Display_all_players;
end;
Procedure Show_dice(Var Cup: Dice);
Var Top: string[3];
Bottom: string[3];
Middle: string[3];
Die_number: integer;
Top_line: integer;
X_pos: integer;
Line: integer;
begin
Top:= #218 + #196 +#191;
Bottom:= #192 + #196 + #217;
for line:= 11 to 13 do
begin
gotoxy(1,line);
clreol;
end;
for line:= 19 to 21 do
begin
gotoxy(1,line);
clreol;
end;
For Die_number:= 1 to 6 do
begin
If Cup[Die_number].Saved
then
Top_line:= 11
else
Top_line:= 19;
if Cup[Die_number].Pulled
then
begin
Textcolor(black);
Textbackground(white);
end;
x_pos:= 5 * (Die_number);
gotoxy(x_pos,Top_line);
write(Top);
gotoxy(x_pos,Top_line + 1);
write(#179,Cup[Die_number].Value:1,#179);
gotoxy(x_pos,Top_line + 2);
write(Bottom);
if Cup[Die_number].Pulled
then
begin
Textcolor(white);
Textbackground(black);
end;
end;
end;
Procedure Turn_stats(Saved_points,Points_available:real);
begin
window(2,2,34,23);
clrscr;
writeln;
writeln(' Current Player Information');
writeln;
writeln('Player: ',Score[Current_player].Player_name);
writeln;
write('On the board? ');
if Score[Current_player].On_board
then
writeln('YES')
else
begin
Textcolor(Black);
Textbackground(White);
writeln('NO');
Textcolor(White);
Textbackground(Black);
end;
write('Points needed: ');
Needed:= Last_players_score + 50.0;
if Score[Current_player].On_board and (Needed <= 350.0)
then
Needed:= 350.0;
if (not Score[Current_player].On_board) and (Needed <= 500.0)
then
Needed:= 500.0;
writeln(' ',Needed:6:0);
writeln('The points available are: ',Points_available:5:0);
writeln;
writeln('Dice_saved:');
gotoxy(1,15);
writeln('Value of the dice saved: ',Saved_points:5:0);
writeln;
writeln;
writeln('The dice on the table are:');
end;
Procedure Test_cup;
Var i: integer;
begin
Randomize;
For i:= 1 to 6 do
begin
Cup[i].Saved:= False;
Cup[i].Marked:= False;
end;
Cup[1].Value:= 2;
Cup[2].Value:= 2;
Cup[3].Value:= 2;
Cup[4].Value:= 2;
Cup[5].Value:= 2;
Cup[6].Value:= 2;
end;
Function Score_pulled(Var Cup:Dice):real;
Var Points_this_pass: real;
i: integer;
j: integer;
Count: integer;
Talley: array[1..6] of integer;
Ones: integer;
Twos: integer;
Threes: integer;
Fours: integer;
Fivers: integer;
Sixes: integer;
Function Aces(Var Cup:Dice):real;
Var i: integer;
Count:integer;
begin
count:= 0;
For i:= 1 to 6 do
if ((Cup[i].Value = 1) and Cup[i].Pulled) and
not (Cup[i].Marked)
then
begin
Cup[i].Marked:= True;
Count:= Count + 1;
end;
Aces:= 100.0 * Count;
end;
Function Fives(Var Cup:Dice):real;
Var i: integer;
Count:integer;
begin
count:= 0;
For i:= 1 to 6 do
if ((Cup[i].Value = 5) and Cup[i].Pulled) and
not (Cup[i].Marked)
then
begin
Cup[i].Marked:= True;
Count:= Count + 1;
end;
Fives:= 50.0 * Count;
end;
Procedure Anomaly(Var Cup:Dice);
Var Point: real;
Count: integer;
I: integer;
J: integer;
begin
for i:= 1 to 6 do
Cup[I].Marked:= False;
i:= 1;
while Talley[I] <> 4 do
I:= I + 1;
Point:= 100.0 * I;
if I = 1
then
Point:= 1000.0;
Count:= 0;
for J:= 1 to 6 do
begin
if (Cup[J].Value = I) and (Count < 3)
then
begin
Cup[J].Marked:= True;
Count:= Count + 1;
end;
end;
Point:= Point + Aces(Cup) + fives(Cup);
for I:= 1 to 6 do
begin
if not Cup[I].Marked
then
Count:= -1;
Cup[I].Marked:= True;
end;
if Count < 0
then
Point:= 0.0;
if Point > 500
then
Points_this_pass:= Point;
end;
begin
Count:= 0;
Points_this_pass:= 0.0;
fillchar(Talley,Sizeof(Talley),0);
for i:= 1 to 6 do
if (not Cup[i].saved) and Cup[i].Pulled
then
begin
Count:= Count + 1;
Talley[Cup[i].Value]:= Talley[Cup[i].Value] + 1;
Cup[i].Marked:= False;
end;
if Count >0
then
begin
Ones:= 0;
Twos:= 0;
Threes:= 0;
Fours:= 0;
Fivers:= 0;
Sixes:= 0;
for i:= 1 to 6 do
Case Talley[i] of
1: Ones:= Ones + 1;
2: Twos:= Twos + 1;
3: Threes:= Threes + 1;
4: Fours:= Fours + 1;
5: Fivers:= Fivers + 1;
6: Sixes:= Sixes + 1;
end;
if Ones = 6
then
begin
Points_this_pass:= 1500;
for i:= 1 to 6 do
Cup[i].Marked:= true;
end;
if (Twos = 3) or ((Twos = 1) and (Fours = 1))
then
begin
Points_this_pass:= 500;
for i:= 1 to 6 do
Cup[i].Marked:= True;
end;
if Sixes = 1
then
begin
i:= 1;
while Talley[i] <>6 do
i:= i + 1;
Points_this_pass:= 2 * 100.0 * i;
if i = 1
then
Points_this_pass:= 2000.0;
for i:= 1 to 6 do
if Cup[i].Pulled
then
Cup[i].Marked:= True;
end;
if Fours = 1
then
begin
i:= 1;
while Talley[i] <>4 do
i:= i + 1;
Count:= 0;
for j:= 1 to 6 do
if(Cup[J].Value = I) and (not Cup[J].Marked)
then
Count:= Count + 1;
if Count >= 3
then
begin
Points_this_pass:= 100.0 * i;
if i = 1
then
Points_this_pass:= 1000.0;
Count:= 0;
for j:= 1 to 6 do
begin
if (Cup[j].Value = i) and
(Count < 3) and
(Cup[j].Pulled) and
(not Cup[J].Marked)
then
begin
Cup[j].Marked:= True;
Count:= Count + 1;
end;
end;
end;
end;
if (Twos = 1) and (Fours = 1)
then
anomaly(Cup);
if Threes > 0
then
begin
Threes:= Threes - 1;
i:= 1;
while Talley[i] <>3 do
i:= i + 1;
Points_this_pass:= 100.0 * i;
If i = 1
then
Points_this_pass:= 1000.0;
for j:= 1 to 6 do
if (Cup[j].Value = i) and Cup[j].Pulled
then
Cup[j].Marked:= True;
end;
if Threes = 1
then
begin
i:= i + 1;
while Talley[i] <>3 do
i:= i + 1;
Points_this_pass:= 100.0 * i + Points_this_pass;
If i = 1
then
Points_this_pass:= 1000.0 + Points_this_pass;
for j:= 1 to 6 do
if (Cup[j].Value = i) and Cup[j].Pulled
then
Cup[j].Marked:= True;
end;
if fivers = 1
then
begin
i:= 1;
while Talley[i] <>5 do
i:= i + 1;
Points_this_pass:= 100.0 * i;
If i = 1
then
Points_this_pass:= 1000.0;
Count:= 0;
for j:= 1 to 6 do
if (Cup[j].Value = i) and (Count < 3) and
(Cup[j].Pulled)
then
begin
Cup[j].Marked:= True;
Count:= Count + 1;
end;
end;
Points_this_pass:= Points_this_pass + Aces(Cup) + Fives(Cup);
end;
for i:= 1 to 6 do
if (Cup[i].Pulled) and not Cup[i].Marked
then
Points_this_pass:= -1.0;
for i:= 1 to 6 do
Cup[i].Marked:= False;
Score_pulled:= Points_this_pass;
end;
Function Score_unsaved(Var Cup:Dice):real;
Var Points_this_pass: real;
i: integer;
j: integer;
Count: integer;
Talley: array[1..6] of integer;
Ones: integer;
Twos: integer;
Threes: integer;
Fours: integer;
Fivers: integer;
Sixes: integer;
Function Aces(Var Cup:Dice):real;
Var i: integer;
Count:integer;
begin
count:= 0;
For i:= 1 to 6 do
if ((Cup[i].Value = 1) and not Cup[i].Saved) and
not (Cup[i].Marked)
then
begin
Cup[i].Marked:= True;
Count:= Count + 1;
end;
Aces:= 100.0 * Count;
end;
Function Fives(Var Cup:Dice):real;
Var i: integer;
Count:integer;
begin
count:= 0;
For i:= 1 to 6 do
if ((Cup[i].Value = 5) and not Cup[i].Saved) and
not (Cup[i].Marked)
then
begin
Cup[i].Marked:= True;
Count:= Count + 1;
end;
Fives:= 50.0 * Count;
end;
Procedure Anomaly;
begin
end;
begin
Count:= 0;
Points_this_pass:= 0.0;
fillchar(Talley,Sizeof(Talley),0);
for i:= 1 to 6 do
if not Cup[i].saved
then
begin
Count:= Count + 1;
Talley[Cup[i].Value]:= Talley[Cup[i].Value] + 1;
Cup[i].Marked:= False;
end;
if Count >0
then
begin
Ones:= 0;
Twos:= 0;
Threes:= 0;
Fours:= 0;
Fivers:= 0;
Sixes:= 0;
for i:= 1 to 6 do
Case Talley[i] of
1: Ones:= Ones + 1;
2: Twos:= Twos + 1;
3: Threes:= Threes + 1;
4: Fours:= Fours + 1;
5: Fivers:= Fivers + 1;
6: Sixes:= Sixes + 1;
end;
if Ones = 6
then
begin
Points_this_pass:= 1500;
for i:= 1 to 6 do
Cup[i].Marked:= true;
end;
if Twos = 3
then
begin
Points_this_pass:= 500;
for i:= 1 to 6 do
Cup[i].Marked:= True;
end;
if Sixes = 1
then
begin
i:= 1;
while Talley[i] <>6 do
i:= i + 1;
Points_this_pass:= 2 * 100.0 * i;
if i = 1
then
Points_this_pass:= 2000.0;
for i:= 1 to 6 do
if not Cup[i].Saved
then
Cup[i].Marked:= True;
end;
if Fours = 1
then
begin
i:= 1;
while Talley[i] <>4 do
i:= i + 1;
Points_this_pass:= 100.0 * i;
if i = 1
then
Points_this_pass:= 1000.0;
Count:= 0;
for j:= 1 to 6 do
begin
if (Cup[j].Value = i) and (Count < 3) and
(Cup[j].Pulled)
then
begin
Cup[j].Marked:= True;
Count:= Count + 1;
end;
end;
end;
if (Twos = 3) and (Fours = 1)
then
anomaly;
if Threes > 0
then
begin
Threes:= Threes - 1;
i:= 1;
while Talley[i] <>3 do
i:= i + 1;
Points_this_pass:= 100.0 * i;
If i = 1
then
Points_this_pass:= 1000.0;
for j:= 1 to 6 do
if (Cup[j].Value = i) and Cup[j].Pulled
then
Cup[j].Marked:= True;
end;
if Threes = 1
then
begin
i:= i + 1;
while Talley[i] <>3 do
i:= i + 1;
Points_this_pass:= 100.0 * i + Points_this_pass;
If i = 1
then
Points_this_pass:= 1000.0 + Points_this_pass;
for j:= 1 to 6 do
if (Cup[j].Value = i) and Cup[j].Pulled
then
Cup[j].Marked:= True;
end;
if fivers = 1
then
begin
i:= 1;
while Talley[i] <>5 do
i:= i + 1;
Points_this_pass:= 100.0 * i;
If i = 1
then
Points_this_pass:= 1000.0;
Count:= 0;
for j:= 1 to 6 do
if (Cup[j].Value = i) and (Count < 3) and
(Cup[j].Pulled)
then
begin
Cup[j].Marked:= True;
Count:= Count + 1;
end;
end;
Points_this_pass:= Points_this_pass + Aces(Cup) + Fives(Cup);
end;
for i:= 1 to 6 do
Cup[i].Marked:= False;
Score_unsaved:= Points_this_pass;
end;
Procedure Start_it_off;
Var Player: integer;
Name: string[100];
Ok: boolean;
Result: integer;
Ch: char;
Procedure Instructions;
{$I Instruct.pas }
begin
Ok:= False;
Initialize_all;
window(2,2,34,24);
clrscr;
writeln;
writeln(' 5,000');
writeln;
writeln('Welcome to a game of skill and');
write('Chance. The dice are HOT, so I''ll');
writeln('handle them for you. I also');
write('assume that you wish to play this');
writeln('game for money--the stakes are:');
writeln('a Quarter a game, and a Dime a');
writeln('scratch.');
writeln;
writeln;
write('Do you need an introduction? ');
read(kbd,Ch);
if upcase(Ch) = 'Y'
then
Instructions;
repeat
gotoxy(1,13);
clreol;
write('How many players (1-15)?- ');
readln(Name);
Name:= copy(Name,1,2);
val(Name,Number_of_players,Result);
until (Number_of_players > 0) and
(Number_of_players < 16) and
(Result = 0);
writeln;
writeln('Now I need your names. If you');
writeln('want me to play, call me Comp1,');
writeln('Comp2, or Comp3.');
writeln;
for Player:= 1 to Number_of_players do
begin
Name:= '';
repeat
gotoxy(1,19);
clreol;
write('Player No. ',Player:2,' ');
readln(Name);
if copy(Name,1,5) = 'Comp1'
then
Score[Player].Player_type:= Comp_1;
if copy(Name,1,5) = 'Comp2'
then
Score[Player].Player_type:= Comp_2;
{if (Name = 'Comp3')
then
begin
Ok:= False;
gotoxy(1,19);
write('I''m sorry, I have a headache');
Delay(1500);
Name:= '';
end;}
if copy(Name,1,5) = 'Comp3'
then
Score[Player].Player_type:= Comp_3;
Ok:= Name <> '';
until Ok;
Score[Player].Player_name:= copy(Name,1,20);
Display_all_players;
window(2,2,34,24);
end;
gotoxy(1,19);
clreol;
Current_player:= random(Number_of_players) + 1;
writeln('I''ve randomly chosen the first');
writeln('player: ',Score[Current_player].Player_name);
writeln;
writeln('Good luck ladies and gentlemen!');
delay(2500);
end;
Procedure Play_a_hand(Player:integer);
Var Pulled_score: real;
Points_saved: real;
Points_available: real;
I: integer;
Count: integer;
Scratch: boolean;
Chicken: boolean;
First_roll: boolean;
Ch: char;
{$I Computer.Pas }
Procedure Pull_dice(Var Cup:Dice);
Const Pointer = '^';
Pointer_loc: array[1..6] of integer = (6,11,16,21,26,31);
Left = #075;
Right = #077;
Space = ' ';
Rtn = #013;
Esc = #027;
Line = 22;
Var x_pos: integer;
I: integer;
Ch: char;
All_done: boolean;
begin
I:= 0;
All_done:= False;
repeat
I:= I + 1;
until (I = 6) or (not Cup[I].Saved);
gotoxy(1,Line);
clreol;
repeat
x_pos:= Pointer_loc[I];
gotoxy(x_pos,Line);
write(Pointer);
read(kbd,Ch);
if (Ch = Esc) and keypressed
then
read(kbd,Ch);
case upcase(Ch) of
Left: begin
gotoxy(x_pos,Line);
write(' ');
repeat
I:= I - 1;
if I < 1
then
I:= 6;
until not Cup[I].Saved;
x_pos:= Pointer_loc[I];
gotoxy(x_pos,Line);
write(' ');
end;
Right: begin
gotoxy(x_pos,Line);
write(' ');
repeat
I:= I + 1;
if I > 6
then
I:= 1;
until not Cup[i].Saved;
x_pos:= Pointer_loc[I];
gotoxy(x_pos,Line);
write(' ');
end;
' ': if Cup[I].Pulled
then
Cup[I].Pulled:= False
else
Cup[I].Pulled:= True;
Rtn:All_done:= True;
end;
Show_dice(Cup);
until All_done;
gotoxy(1,line);
clreol;
end;
begin
Points_saved:= 0.0;
Points_available:= 0.0;
Scratch:= False;
First_roll:= True;
Problems:= False;
Chicken:= False;
Ch:= 'N';
for I:= 1 to 6 do
begin
Cup[I].Pulled:= False;
Cup[I].Saved:= False;
end;
Turn_stats(Points_saved,Points_available);
Show_dice(Cup);
repeat
if (Points_available < Needed) and
(Score[Current_player].Player_type = Human)
then
begin
gotoxy(1,22);
write('Press any key to roll dice');
repeat
I:= random(6) + 1;
until keypressed;
end;
gotoxy(1,22);
clreol;
for I:= 1 to 6 do
if not Cup[I].Saved
then
Cup[I].Value:= random(6) + 1;
Show_dice(Cup);
Scratch:= (Score_unsaved(Cup) = 0.0);
if First_roll and Scratch
then
Score[Current_player].Scratches:=
Score[Current_player].Scratches + 1;
First_roll:= False;
if not Scratch
then
begin
repeat
if Score[Current_player].Player_type = Human
then
Pull_dice(Cup)
else
begin
Chicken:= Computer_player(Cup);
if Chicken
then
Ch:= 'Y'
else
Ch:= 'N';
Show_dice(Cup);
Delay(3000)
end;
Pulled_score:= Score_pulled(Cup);
Problems:= False;
if Pulled_score < 0.0
then
begin
gotoxy(1,22);
write('All pulled dice do not SCORE',#007);
delay(1500);
Problems:= True;
for I:= 1 to 6 do
Cup[I].Pulled:= False;
end;
if Pulled_score = 0.0
then
begin
gotoxy(1,22);
write('You must pull a Score!');
delay(1500);
Problems:= True;
end;
until Pulled_score > 0.0;
Points_saved:= Points_saved + Pulled_score;
Points_available:= Points_available + Pulled_score;
for I:= 1 to 6 do
if Cup[I].Pulled
then
begin
Cup[I].Saved:= True;
Cup[I].Pulled:= False;
end;
Turn_stats(Points_saved,Points_available);
Show_dice(Cup);
if Score[Current_player].Player_type = Human
then
if Points_available >= Needed
then
repeat
gotoxy(1,22);
clreol;
write('Quit while you''re ahead? ');
read(kbd,Ch);
until (upcase(Ch) = 'Y') or
(upcase(Ch) = 'N');
Chicken:= (upcase(Ch) = 'Y');
end;
Count:= 0;
for I:= 1 to 6 do
if Cup[I].Saved
then
Count:= Count + 1;
if Count = 6
then
begin
Points_saved:= 0.0;
for I:= 1 to 6 do
Cup[I].Saved:= false;
end;
until Scratch or Chicken;
if Scratch
then
begin
Last_players_score:= 0.0;
Score[Current_player].Scratches:=
Score[Current_player].Scratches + 1;
gotoxy(10,22);
write('TOO BAD.. YOU SCRATCHED');
delay(1500);
end
else
begin
if Points_available >= 500.0
then
Score[Current_player].On_board:= True;
Last_players_score:= Points_available;
Score[Current_player].Points:=
Score[Current_player].Points + Points_available;
if Score[Current_player].Points > Score[0].Points
then
Score[0].Points:= Score[Current_player].Points;
end;
end;
Procedure Play_a_game;
Var Whose_over: integer;
Max_score: real;
Winner: integer;
Player: integer;
begin
Someone_over:= False;
repeat
Play_a_hand(Current_player);
if Score[Current_player].Points >= 5000.0
then
begin
Someone_over:= True;
Whose_over:= Current_player;
end
else
Last_player:= Current_player;
Current_player:= Current_player + 1;
if Current_player > Number_of_players
then
Current_player:= 1;
Last_player:= Current_player - 1;
if Last_player = 0
then
Last_Player:= Number_of_players;
Display_all_players;
until Someone_over;
repeat
Play_a_hand(Current_player);
Last_player:= Current_player;
Current_player:= Current_player + 1;
if Current_player > Number_of_players
then
Current_player:= 1;
Display_all_players;
until Current_player = Whose_over;
Max_score:= Last_players_score;
for Player:= 1 to Number_of_players do
if Score[Player].Points > Max_score
then
begin
Winner:= Player;
Max_score:= Score[Player].Points;
end;
Current_player:= Winner;
Last_player:= 0;
Last_players_score:= 0.0;
end;
Procedure Show_winnings;
Type Ending = (win,lose);
Var Pay_off: array[win..lose,1..Max_players] of real;
Winner_gets: real;
Player: integer;
Played_to: ending;
begin
Winner_gets:= 0.0;
fillchar(Pay_off,sizeof(Pay_off),0);
for Player:= 1 to Number_of_players do
begin
if Player <> Current_player
then
Played_to:= lose
else
Played_to:= win;
Pay_off[Played_to,Player]:= 0.25 + 0.1 * Score[Player].Scratches;
if Score[Player].Points = 0.0
then
Pay_off[Played_to,Player]:= Pay_off[Played_to,Player]*2;
Winner_gets:= Winner_gets + Pay_off[Played_to,Player];
end;
Winner_gets:= Winner_gets - 0.25 -
0.1 * Score[Current_player].Scratches;
Pay_off[win,Current_player]:= Winner_gets;
for Player:= 1 to Number_of_players do
begin
Winnings[Player]:= Pay_off[win,Player] + Winnings[Player];
Losses[Player]:= Pay_off[lose,Player] + Losses[Player];
end;
window(2,2,34,24);
clrscr;
writeln;
writeln;
writeln('Here''s the results of this game:');
writeln;
writeln(' Player Wins Loses');
for Player:= 1 to Number_of_players do
begin
write(Player:2,' ',Score[Player].Player_name);
gotoxy(23,Player + 6);
write('$',Pay_off[win,Player]:4:2,' $',Pay_off[lose,Player]:4:2);
end;
window(36,2,78,24);
clrscr;
gotoxy(1,1);
writeln;
writeln(' PLAYERS AND THEIR WINNINGS');
writeln;
writeln;
writeln(' Name Winnings Losses');
writeln;
for Player:= 1 to Number_of_players do
begin
write(Player:2,': ',Score[Player].Player_name);
gotoxy(25,6 + Player);
writeln('$',Winnings[Player]:5:2,' $',
Losses[Player]:5:2);
end;
write('The number of games Played = ',Games_played:4);
end;
begin
Randomize;
Start_it_off;
Test_cup;
Humans_want_to_play:= True;
while Humans_want_to_play do
begin
Play_a_game;
Games_played:= Games_played + 1;
Show_winnings;
repeat
gotoxy(1,22);
clreol;
write(' Do you want to play again? ');
read(kbd,Ch);
Ch:= upcase(Ch);
until (Ch = 'Y') or (Ch = 'N');
if Ch = 'N'
then
Humans_want_to_play:= False;
for index:= 1 to Number_of_players do
with Score[index] do
begin
Points:= 0.0;
Scratches:= 0;
On_board:= False;
end;
end;
end.